# 53 Longest Increasing Sub-Seq
(de f53 (Lst)
   (maxi 
      length
      (filter
         '((I) (and (car I) (cdr I)))
         (maplist
            '((L)
               (make
                  (link (car L))
                  (for I (cdr L)
                     (NIL (= 1 (- I (last (made)))))
                     (link I) ) ) )
            Lst ) ) ) )
(test
   (0 1 2 3)
   (f53 (1 0 1 2 3 0 4 5)) )
(test
   (5 6)
   (f53 (5 6 1 3 2 7)) )
(test
   (3 4 5)
   (f53 (2 3 3 4 5)) )
(test
   NIL
   (f53 (7 6 5 4)) )

#73 Analyze a Tic-Tac-Toe Board
(de f73 (Lst)
   (pick
      '((L)
         (and
            (or 
               (apply = L 'x)
               (apply = L 'o) )
            (car L) ) ) 
      (list
         (car Lst)
         (cadr Lst)
         (caddr Lst)
         (mapcar car Lst)
         (mapcar cadr Lst)
         (mapcar caddr Lst)
         (mapcar get Lst (1 2 3))
         (mapcar get Lst (3 2 1)) ) ) )
(test
   NIL      
   (f73 '((e e e)
          (e e e)
          (e e e) ) ) )
(test
   'x
   (f73 '((x e o)
          (x e e)
          (x e o) ) ) )
(test
   'o
   (f73 '((e x e)
          (o o o)
          (x e x) ) ) )
(test
   NIL
   (f73 '((x e o)
          (x x e)
          (o x o) ) ) )
(test
   'x
   (f73 '((x e e)
          (o x e)
          (o e x) ) ) )
(test
   'o
   (f73 '((x e o)
          (x o e)
          (o e x) ) ) )
(test
   NIL
   (f73 '((x o x)
          (x o x)
          (o x o) ) ) )

#92 Read Roman numerals
(de f92 (Rom)
   (let L (replace (chop Rom) 'M 1000 'D 500 'C 100 'L 50 'X 10 'V 5 'I 1)
      (sum '((A B) (if (>= A B) A (- A))) L (cdr L)) ) )
(test
   14
   (f92 "XIV") )
(test
   827
   (f92 "DCCCXXVII") )
(test
   3999
   (f92 "MMMCMXCIX") )
(test
   48
   (f92 "XLVIII") )

#79 Triangle Minimal Path
# reduce from task 64 (elementary.l)
(de f79 (Lst)
   (car
      (reduce
         '((X Y)
            (mapcar
               +
               (maplist
                  '((L)
                     (and (cdr L) (min (car L) (cadr L))) )
                  X )
               Y ) )
         (reverse Lst) ) ) )
(test
   7
   (f79
      '((1)
      (2 4)
      (5 1 4)
      (2 3 4 5) ) ) )
(test
   20
   (f79
      '((3)
      (2 4)
      (1 9 3)
      (9 9 2 4)
      (4 6 6 7 8)
      (5 7 3 5 1 4) ) ) )

#84 Transitive Closure
(de f84 (Lst)
   (make
      (for I Lst
         (link I)
         (when (assoc (cdr I) Lst)
            (link
               (cons (car I) (cdr @)) ) ) ) ) ) 
(test
   '((8 . 4) (8 . 2) (9 . 3) (4 . 2) (27 . 9) (27 . 3)) 
   (f84 '((8 . 4) (9 . 3) (4 . 2) (27 . 9))) )

#91 Graph Connectivity
(de f91 (Lst)
   (let (X (caar Lst)  R)
      (not
         (diff 
            (uniq (fish atom Lst))
            (recur (X)
               (cond
                  ((not X))
                  ((lst? X)
                     (recurse (car X))
                     (recurse (cdr X)) )
                  (T (push 'R X)
                     (when 
                        (extract
                           '((I)
                              (let Y
                                 (cond
                                    ((= (car I) X) (cadr I))
                                    ((= (cadr I) X) (car I)) )
                                 (unless (member Y R) Y) ) )
                              Lst ) 
                        (recurse @) ) ) )
               R ) ) ) ) )
(test
   T
   (f91 '((a a))) )
(test
   T
   (f91 '((a b))) )
(test
   NIL
   (f91 '((1 2) (2 3) (3 1) (4 5) (5 6) (6 4))) )
(test
   T
   (f91 '((1 2) (2 3) (3 1) (4 5) (5 6) (6 4) (3 4))) )
(test
   NIL
   (f91 '((:a :b) (:b :c) (:c :d) (:x :y) (:d :a) (:b :e))) )
(test
   T
   (f91 '((:a :b) (:b :c) (:c :d) (:x :y) (:d :a) (:b :e) (:x :a))) )

#82 Word Chains
(de antidup @
# remove fatal duplicates
# input: two lists
# output:
# ((("s" "i" "o" "t") . 4) (("p" "o" "t") . 3))
# longest always first
   (let R
      (mapcar
         '((L)
            (let Y NIL
               (for I L
                  (accu 'Y I 1) )
               (setq Y
                  (make
                     (for I Y
                        (chain (need (% (cdr I) 2) (car I))) ) ) )
               (cons Y (length Y)) ) )
         (rest) )
      (when (<= (cdar R) (cdadr R))
         (xchg R (cdr R)) )
      R ) )
(de f82 (Lst)
   (let (L Lst  P NIL)
      (sym? 
         (recur (L)
            (if (cdr L)
               (do (length L)
                  (T (= 'chain (recurse (cdr L))) 'chain)
                  (rot L) )
               (for (L1 Lst (cdr L1) (cdr L1))
                  (setq P
                     (antidup (chop (car L1)) (chop (cadr L1))) )
                  (NIL
                     (and
                        (>= 1 (- (cdar P) (cdadr P)))
                        (= 
                           1
                           (cnt
                              '((I) (not (member I (caadr P))))
                              (caar P) ) ) ) )
                  'chain ) ) ) ) ) )
(test
   T
   (f82 '(hat coat dog cat oat cot hot hog)) )
(test
   NIL
   (f82 '(cot hot bat fat)) )
(test
   NIL
   (f82 '(to top stop tops toss)) )
(test
   T
   (f82 '(spout do pot pout spot dot)) )
(test
   T
   (f82 '(share hares shares hare are)) )
(test
   NIL
   (f82 '(share hares hare are)) )

#94 Game of Life
(de f94 (Lst)
   (let 
      (Lst (mapcar chop Lst) 
         Grid (grid (length (car Lst)) (length Lst)) )
      (mapc
         '((G L)
            (mapc '((This) (=: life NIL)) G)
            (mapc
               '((This Val)
                  (when (= 'X Val) (=: life T)) )
               G 
               L ) )
         Grid
         (apply mapcar (reverse Lst) list) )
      (for Col Grid
         (for This Col
            (let N
               (cnt
                  '((Dir) (get (Dir This) 'life))
                  (quote
                     west east south north
                     ((X) (south (west X)))
                     ((X) (north (west X)))
                     ((X) (south (east X)))
                     ((X) (north (east X))) ) )
               (=: next
                  (if (: life)
                     (>= 3 N 2)
                     (= N 3) ) ) ) ) )
         (for Col Grid
            (for This Col
               (=: life (: next)) ) )
      (mapcar
         '((L)
            (pack 
               (mapcar
                  '((This) (if (: life) 'X " ") )
                  L ) ) )
         (reverse (apply mapcar Grid list)) ) ) )
(test
   '("      "
     " XX   " 
     " X    " 
     "    X " 
     "   XX " 
     "      " )
   (f94 
      '("      "
        " XX   "
        " XX   "
        "   XX "
        "   XX "
        "      " ) ) )
(test
   '("     " 
     "  X  "
     "  X  "
     "  X  "
     "     " )
  (f94
      '("     "
        "     "
        " XXX "
        "     "
        "     " ) ) )
(test
   '("      " 
     "   X  "
     " X  X "
     " X  X "
     "  X   "
     "      " )
   (f94
      '("      "
        "      "
        "  XXX "
        " XXX  "
        "      "
        "      " ) ) ) 

#106 Number Maze
(de f106 (X Y)
   (let (R (list X)  C 1)
      (until (member Y R) 
         (setq R 
            (mapcan
               '((I)
                  (cons
                     (* 2 I)
                     (+ 2 I)
                     (unless (bit? 1 I) (cons (/ I 2))) ) )
               R ) )
         (inc 'C) )
      C ) )
(test
   1
   (f106 1 1) )
(test
   3
   (f106 3 12) )
(test
   3
   (f106 12 3) )
(test
   3
   (f106 5 9) )
(test
   9
   (f106 9 2) )
(test
   5
   (f106 9 12) )

#101 Levenshtein Distance
(de f101 (A B)
   (default
      A (need (length B)) 
      B (need (length A)) )
   (let D
      (cons
         (range 0 (length A))
         (mapcar
            '((I) (cons I (copy A)))
            (range 1 (length B)) ) )
      (map
         '((B Y)
            (map
               '((A X P)
                  (set (cdr P)
                     (if (= (car A) (car B))
                        (car X)
                        (inc (min (cadr X) (car P) (car X))) ) ) )
               A
               (car Y)
               (cadr Y) ) )
         B
         D ) ) )
(test
   3
   (f101 (chop "kitten") (chop "sitting")) )
(test
   (f101 (chop "clojure") (chop "closure"))
   (f101 (chop "closure") (chop "clojure")) )
(test
   10
   (f101 (chop "ttttattttctg") (chop "tcaaccctaccat")) )
(test
   (f101 (chop "123") (chop ""))
   (f101 (chop "") (chop "abc")) )

#89 Graph Tour
# (Node In Out)
# Every Node
#    In must be odd (0 or 2)
#    Out =0
(de accul (Var Key Flag)
   (use L
      (if (setq L (assoc Key (val Var)))
         (con L (list (inc (cdr L)) (caddr L)))
         (push Var (list Key 1 0)) )
      (when Flag
         (setq L (assoc Key (val Var)))
         (con L (list (cadr L) (inc (cddr L)))) ) ) )
(de f89 (Lst)
   (use R
      (for L Lst
         (if (= (car L) (cadr L))
            (accul 'R (car L))
            (accul 'R (car L) T)
            (accul 'R (cadr L) T) ) )
      (bool
         (and
            (=0 
               (cnt '((L) (= 0 (caddr L))) R))
            (let X (cnt '((L) (bit? 1 (cadr L))) R)
               (or (=0 X) (= 2 X)) ) ) ) ) )
(test
   T
   (f89 '((:a :b))) )
(test
   NIL
   (f89 '((:a :a) (:b :b))) )
(test
   NIL
   (f89 '((:a :b) (:a :b) (:a :c) (:c :a)
      (:a :d) (:b :d) (:c :d) ) ) )
(test
   T
   (f89 '((1 2) (2 3) (3 4) (4 1))) )
(test
   T
   (f89 '((:a :b) (:a :c) (:c :b) (:a :e)
      (:b :e) (:a :d) (:b :d) (:c :e) 
      (:d :e) (:c :f) (:d :f) ) ) )
(test
   NIL
   (f89 '((1 2) (2 3) (2 4) (2 5))) )

